perm filename 58810[PAG,LCS]1 blob sn#629725 filedate 1981-12-19 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
00300		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00400		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00500		1 RCLEF(0/7) /IVV/IV(1)
00600		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00700	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00800		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00900		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
01000	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01100	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01200		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01300		INTEGER DUMMY
01400		COMMON /PX/PN(1) /Q/Q(1)
01500		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01600		1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01700		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
01800		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
01900		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02000		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02100		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02200		1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02300		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
02400		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
02500		1 ,O1/0.01/,O11/0.011/
02600	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
02700	
02800		IF(NMPG.NE.'PAGEA')GO TO 2000
02900	C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
03000		RNEXT=0
03100	2000	SPCNT=1.0
03200		JX=0
03300		JCEN=0
03400	C  FLAG FOR CENTERED RESTS.
03500		XT=0
03600		JK=1
03700	C JK IS USED AT END.  IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
03800		PX=0
03900		CALL SHFT1(KQ)
04000		KK=L
04100	CC	TYPE 3001,L
04200	C  DELETES EXTRA BAR LINES, ETC.
04300		IF(IPG)CALL RESTS
04400	C???	IF(N)RETURN 
04500	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04600	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04700		CALL SHIFT
04800	C  L=NUMBER OF ITEMS FOR RHY RECONS.
04900		JJ2=L+2
05000	C FOR WDCNT IN .PAG FILE
05100		IF(IPG.EQ.2)GO TO 11
05200	C IPG=2=REORDER INPUT FILE ONLY.
05300		N=0
05400		S=-100
05500		R=0
05600		KCLEF=0
05700		NOGRCE=-1
05800	C  GRACE NOTE FLAG
05900		TTT=0
06000	C FOR IRREG. NUMS. OF STAVES.
06100	
06200	C******** BIG LOOP ***************
06300	161	DO 601 K=1,L
06400		R=CODEN(KPN,K,Q,J)
06500		RZ=Q(J)
06600	CX	J=KPN(K)
06700	CC	N=N+1
06800	CC	NN(N)=0
06900	CC	MM(N)=J+3
07000		CALL MMNN(3)
07100		NN(N)=-R
07200	C MAKE ALL CODE NUMS NEG. AT FIRST.  CHANGE 1,2,3,4,17,18 LATER
07300	CX	R=Q(J+1)
07400		IF(R.GT.2)GO TO 1801
07500		IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07600	C FINDS HIGHEST STAFF NUM.  NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07700		IF(R.NE.1)GO TO 2801
07800		IF(RZ.LT.7)GO TO 601
07900		IF(Q(J+9).LE.0)GO TO 601
08000	C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
08100		IF(Q(J+9).NE.4./88.)GO TO 702
08200	CC	IF(Q(J+9).GT..05)GO TO 702
08300	CC	IF(Q(J+8).EQ.1000)GO TO 601
08400	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08500		NOGRCE=0
08600		GO TO 601
08700	CCC2801	IF(R.NE.2)GO TO 1801
08800	2801	RS=Q(J+7)
08900		IF(RZ.LT.7)GO TO 3801
09000	C DELETE ALL UP TO LABEL 1801 LATER.  NEW CENTERED REST FEATURE. 5/29/78
09100	CXX	NN(N)=-NN(N)
09200		IF(Q(J+9).NE.0)Q(J+9)=-1
09300	C  SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
09400		IF(Q(J+8).EQ.0)GO TO 601
09500	C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
09600		IF(RS.LE.0)GO TO 601
09700	C SKIP RESTS WITH NO RHYTHM VALUE IN P7
09800		GO TO 702
09900	C??? NOW MAKE CODE NUM. POS.
10000	CC	NN(N)=R
10100	CC	GO TO 688
10200	3801	IF(RZ.LT.5)GO TO 601
10300		IF(RS.LE.0)GO TO 601
10400		IF(IPG)GO TO 702
10500		IF(RZ.LT.6)GO TO 702
10600		IF(Q(J+6))GO TO 702
10700	C PARAM 6=-1 = INVISIBLE. SHOULDN'T BE WHOLE REST (P8) ANYWAY.
10800		RS=Q(J+3)
10900	C GET POS. OF CENTERED WHOLE REST
11000		TT=0
11100		B=Q(J+2)
11200	C GET THE STAFF NUM.
11300		DO 602 M=1,L
11400		T=CODEN(KPN,M,Q,JJ)
11500		A=Q(JJ+3)
11600	C GET POS. OF ITEM
11700		IF(A.GT.RS)GO TO 602
11800	C JUMP IF ITEM IS TO RIGHT OF REST
11900		IF(T.NE.4)GO TO 602
12000	C IS THE ITEM A BAR LINE
12100		IF(Q(JJ+4).LT.0)GO TO 602
12200	C**** SKIP IF INVIS. BAR (P4=-1)
12300		IF(A.GT.TT)TT=A
12400	C FINDS BAR LINE CLOSEST TO LEFT OF REST
12500	602	CONTINUE
12600	C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12700		T=20000
12800		A=20000
12900	C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
13000		DO 613 M=1,L
13100		IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13200		IF(Q(JJ).LT.7)GO TO 609
13300	C SKIP IF RHYTH NOT IN P9
13400		IF(Q(JJ+9).LT..05)GO TO 613
13500	C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13600	609	B=Q(JJ+3)
13700	C POS. OF ITEM
13800		X=B-TT
13900		IF(X)GO TO 613
14000	C JUMP IF ITEM IS TOO FAR TO LEFT
14100		IF(X.GT.A)GO TO 613
14200		A=X
14300		T=B
14400	C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14500	613	CONTINUE
14600		IF(T.NE.20000)GO TO 612
14700	C JUMP IF NOTE OR REST FOUND
14800		JCEN=-1
14900		GO TO 1801
15000	612	Q(J+3)=T
15100	C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15200	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15300	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15400	1801	IF(R.LT.4)GO TO 702
15500		IF(R.EQ.17)GO TO 1702
15600		IF(R.EQ.18)GO TO 1701
15700		IF(R.EQ.10)GO TO 702
15800	C FOUND A NUMBER.  USE THIS IN RESTP
15900		IF(R.LE.7)GO TO 30
16000		IF(R.NE.44)GO TO 601
16100		IF(RZ.EQ.2)GO TO 601
16200	C RZ=2= BAR LINE ON UPPER STAFF
16300		IF(Q(J+6).EQ.0)GO TO 601
16400		IF(Q(J+5).EQ.0)GO TO 601
16500	C  GETS LEFT END OF LINES, CRESC., DASHES.
16600		GO TO 604
16700	30	IF(R.NE.7)GO TO 605
16800		IF(RZ.LT.5)GO TO 604
16900	C JUMP FOR STANDARD TRILL
17000		RS=Q(J+7)
17100		IF(RS.EQ.1)GO TO 604
17200		IF(ABS(RS).GE.3)GO TO 604
17300	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17400		GO TO 601
17500	605	IF(R.NE.4)GO TO 604
17600		IF(Q(J+4).LT.0)GO TO 601
17700	C*** SKIP IF INVIS. BAR (P4=-1)
17800		IF(RZ.LE.3)GO TO 702
17900	C JUMP IF IT IS A BAR LINE
18000	CC	IF(RZ.LT.4)GO TO 601
18100		IF(Q(J+6).NE.0)GO TO 604
18200	C GO GET OTHER POS OF LINE
18300		GO TO 601
18400	1701	IF(NN(N-1).NE.18)GO TO 1702
18500		IF(Q(J+2).EQ.Q(KPN(K-1)+2))Q(J+4)=-8.
18600	C SHIFT METER DOWN  IF PREVIOUS ITEM WAS ALSO METER. (IN SAME POSITION)
18700	1702	IF(Q(J+4).NE.0)GO TO 601
18800		IF(Q(J+2).NE.0)GO TO 601
18900	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
19000	702	NN(N)=-NN(N)
19100	CC702	NN(N)=R 
19200		GO TO 601
19300	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
19400	604	CALL MMNN(6)
19500	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS  (PUTS -1 INTO NN(X))
19600	CCXX	NN(N)=-1
19700	
19800		IF(R.NE.6)GO TO 601
19900	C NEXT FOR BEAMS
20000		IF(RZ.LT.8)GO TO 608
20100		IF(Q(J+10).EQ.0)GO TO 608
20200		IF(Q(J+8))GO TO 608
20300	C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
20400		IF(Q(J+7).GT.0)CALL MMNN(8)
20500	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
20600	608	IF(RZ.LT.7)GO TO 601
20700		IF(Q(J+7))GO TO 688
20800	C  P7 IS NEG FOR TREMOLO
20900		IF(Q(J+8).EQ.0)GO TO 601
21000	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
21100	688	IF(Q(J+9).GT.0)CALL MMNN(9)
21200	C FOUND A POS. IN P9
21300	601	CONTINUE
21400	
21500		KPG=TTT+1
21600	C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
21700	
21800	C NEXT SORTS THE POINTS
21900	6000	J=1
22000	CC610	IF(NN(J).NE.-16)GO TO 1610
22100	C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1)  PUTS ALL AT SAME P3 LOC.
22200	CC	K=MM(J)
22300	CC	IF(Q(K-3).LT.8)GO TO 1610
22400	CC	IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
22500	CC	GO TO 710
22600	CC1610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22700	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22800		CALL EXCHG(MM(J),NN(J))
22900	C  ABOVE EXCHGS --(J) AND --(J+1)
23000		IF(J.EQ.1)GO TO 710
23100		J=J-1
23200		GO TO 610
23300	710	J=J+1
23400		IF(J.LT.N)GO TO 610
23500	C NOW ALL SORTED
23600		CALL FNDEND(R)
23700		CALL SHFTQ(R)
23800	C  SHIFTS TO PROPER HORIZ. POS.
23900		IF(IPG)CALL RESTP
24000	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
24100		IF(N.LE.0)GO TO 122
24200	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
24300	
24400		DO 119 K=1,150
24500	119	HH(K)=0
24600	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
24700		G(1)=0
24800		E(1)=0
24900		F(1)=0
25000		RN(1500)=0
25100		RN(2500)=0
25200		ST=0
25300	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
25400	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
25500		KE=0
25600		J=1000
25700	933	JJ=1500
25800		JJJ=2000
25900		T=0
26000		M=0
26100		A=0
26200		B=0
26300	
26400		DO 33 K=1,N
26500		IF(NORH(KK,K))GO TO 33
26600	CC	KK=NN(K)
26700	CC	IF(KK.EQ.0)GO TO 33
26800	CC	IF(KK.EQ.4)GO TO 2133
26900	CC	IF(KK.EQ.17)GO TO 2133
27000	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
27100	CC	IF(KK.EQ.18)GO TO 2133
27200	CC	IF(KK.GT.2)GO TO 33
27300	2133	LL=MM(K)-3
27400		IF(KK.LE.2)GO TO 1133
27500		RH=O1
27600	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
27700	CCC	IF(KK.NE.4)RH=.6
27800		GO TO 3133
27900	1133	IF(Q(LL+2).NE.ST)GO TO 33
28000	C JUMP IF NOT ON RIGHT STAFF
28100		RA=9
28200		IF(KK.EQ.2)RA=7
28300		IF(Q(LL).LT.RA-2)GO TO 33
28400	C JUMP IF WDCNT IS TOO SHORT
28500		IF(KK.EQ.1)GO TO 433
28600		IF(Q(LL).LT.6)GO TO 433
28700	C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
28800		RZ=Q(LL+8)
28900	C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
29000		IF(RZ.LE.0)GO TO 433
29100		Q(LL+7)=2
29200	C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
29300		IF(RZ.LT.8)GO TO 433
29400		Q(LL+5)=-3
29500	C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
29600		RZ=RZ/2.0
29700	CC	RZ=IFIX(RZ/2.0)+1.0
29800		IF(RZ.GT.6)RZ=6
29900	C LIMIT OF 8 ON RHYTH VAL.
30000		Q(LL+7)=RZ
30100	433	RH=Q(LL+IFIX(RA))
30200		IF(RH.EQ.0)GO TO 33
30300	3133	RZ=Q(LL+3)
30400		IF(ZERO(RZ,A).EQ.0)GO TO 133
30500	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
30600		RRH=RH
30700	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
30800		TT=T
30900	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
31000		J=J+1
31100	C UPDATE COUNTER IN POSITION ARRAY
31200		T=T+RH
31300	C ADD TO TOTAL RHYTHM
31400		RN(J)=T
31500		A=Q(LL+3)
31600	C SAVE POS. OF THIS NOTE.
31700		GO TO 33
31800	133	IF(RH.EQ.RHH)GO TO 33
31900	C  IGNORE 2ND RHYTH IF SAME AS FIRST
32000		IF(ZERO(RZ,B).EQ.0)GO TO 333
32100	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
32200		TTT=TT
32300	C SAVE TOTAL RHYTHM TO THIS POINT.
32400		TT=TT+RH
32500		JJ=JJ+1
32600	C UPDATE COUNTER FOR 2ND ARRAY
32700		RN(JJ)=TT
32800		RRRH=RH
32900		B=A
33000		GO TO 33
33100	333	IF(RH.EQ.RRRH)GO TO 33
33200		TTT=TTT+RH
33300		JJJ=JJJ+1
33400		RN(JJJ)=TTT
33500	33	CONTINUE
33600	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
33700		IF(ST.NE.0)GO TO 733
33800		KE=J-999
33900	C TOTAL NUM OF RHYTHMS ON STAFF1.
34000	CC	IF(JPG.EQ.0)GO TO 2233
34100		IF(KPG.LE.1)GO TO 2233
34200	C KPG=0=PARTS;    =1=PAGE, 1 STAFF
34300	C  JUMP IF ONLY ONE STAFF
34400	C****733	KF=J-2499
34500	C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
34600	733	ST=ST+1
34700		IF(ST.GT.1)GO TO 833
34800	C JUMP IF ALL STAVES HAVE BEEN READ.
34900	1233	J=2500
35000		GO TO 933
35100	833	IF(J.NE.2500)GO TO 1533
35200	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
35300	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
35400	
35500	2233	CALL RLOOP(HH,E,KE)
35600	C FOR SINGLE STAFF OF RHYTHM
35700		KL=KE
35800		GO TO 1333
35900	1533	K=1
36000		L=1
36100		M=0
36200	19	KK=K
36300		LL=L
36400	1	SM=10000
36500		K=K+1
36600		IF(K.GT.KE)GO TO 10
36700	4	L=L+1
36800		Y=F(L)
36900		B=Y-F(L-1)
37000		IF(B.LT.SM)SM=B
37100	2	X=E(K)
37200		A=X-E(K-1)
37300	C  A AND B HAVE TRUE DURATIONS NOW
37400		IF(A.LT.SM)SM=A
37500	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
37600		IF(ZERO(X,Y).EQ.0)GO TO 3
37700	C JUMP IF EQUAL RHYTHS
37800		IF(X.GT.Y)GO TO 4
37900		K=K+1
38000	C STEP FORWARD UNTIL X IS .GT. Y
38100		GO TO 2
38200	3	IF(K.NE.KK+1)GO TO 13
38300		IF(L.NE.LL+1)GO TO 14
38400		M=M+1
38500		G(M)=E(KK)
38600		GO TO 19
38700	13	IF(L.NE.LL+1)GO TO 15
38800		DO 16 J=KK,K-1
38900		M=M+1
39000	16	G(M)=E(J)
39100		GO TO 19
39200	14	DO 17 J=LL,L-1
39300		M=M+1
39400	17	G(M)=F(J)
39500		GO TO 19
39600	15	XM=SM-.001
39700		M=M+1
39800		P=E(KK)
39900		G(M)=P
40000	7	KK=KK+1
40100		LL=LL+1
40200		YM=SM*1.5
40300	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
40400		S=P
40500		T=P
40600	27	A=E(KK)
40700		B=F(LL)
40800		IF(ZERO(A,B).EQ.0)GO TO 19
40900		X=ZERO(A,P)
41000		Y=ZERO(B,P)
41100	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT.O1)ZERO=0
41200		S=E(KK-1)
41300		T=F(LL-1)
41400	9	IF(A-S.LT.X-O1)X=ZERO(A,S)
41500		IF(B-T.LT.Y-O1)Y=ZERO(B,T)
41600		IF(A.GT.B+O1)GO TO 8
41700		B=A
41800		KK=KK+1
41900	62	IF(X.GT.YM)GO TO 5
42000		IF(X.EQ.0)GO TO 27
42100		P=P+SM
42200	25	M=M+1
42300		G(M)=P
42400		GO TO 27
42500	5	P=P+SM
42600		IF(P)GO TO 2203
42700	C IF(P)ERROR
42800		IF(P.LT.B-O1)GO TO 5
42900		GO TO 25
43000	8	X=Y
43100		LL=LL+1
43200		GO TO 62
43300	10	M=M+1
43400		G(M)=E(KE)
43500	CC	TYPE 410,(E(K),K=1,KE)
43600	CC	TYPE 410,(F(K),K=1,KF)
43700	CC	TYPE 410,(G(K),K=1,M)
43800	CBCB	WRITE(21,410)(E(K),K=1,KE)
43900	CB	WRITE(21,410)(F(K),K=1,KF)
44000	CB	WRITE(21,410)(G(K),K=1,M)
44100	410	FORMAT(10F7.2)
44200	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
44300	C****** NO VITAL RHYTHMS CAN PASS BAR LINES *************
44400	1033	JJ=1
44500		H(1)=0
44600		J=1
44700		K=2
44800		L=2
44900	511	IF(J.EQ.M)GO TO 911
45000		J=J+1
45100		X=G(J)
45200	1211	A=E(K)
45300		B=F(L)
45400		Y=ZERO(X,A)
45500		Z=ZERO(X,B)
45600		IF(A-B.GT.O1)GO TO 1111
45700		IF(Y.EQ.0)GO TO 1311
45800		IF(X.LT.A-O1)GO TO 1111
45900		K=K+1
46000	1411	JJ=JJ+1
46100		H(JJ)=-A
46200		GO TO 1211
46300	1111	IF(Z.EQ.0)GO TO 1311
46400		IF(X.LT.B-O1)GO TO 1311
46500		L=L+1
46600		A=B
46700		GO TO 1411
46800	
46900	1311	JJ=JJ+1
47000		H(JJ)=X
47100		IF(Y.EQ.0)GO TO 611
47200		IF(Z.EQ.0)GO TO 711
47300		IF(ZERO(A,B).EQ.0)GO TO 511
47400		P=A
47500		IF(P.GT.B+O1)GO TO 811
47600		IF(P.GT.X+O1)GO TO 511
47700		K=K+1
47800		GO TO 1011
47900	811	P=B
48000		IF(P.GT.X+O1)GO TO 511
48100		L=L+1
48200	1011	JJ=JJ+1
48300		H(JJ)=-P
48400	C NON-SPACED RHYTHS ARE NEG.
48500		GO TO 511
48600	611	K=K+1
48700		IF(Z.GT.0)GO TO 511
48800	711	L=L+1
48900		GO TO 511
49000	911	IF(HH(2).EQ.0)GO TO 2011
49100		K=2
49200		J=2
49300		L=1
49400		HHH(1)=0
49500	1511	IF(J.GT.JJ)GO TO 1811
49600		P=H(J)
49700		A=ABS(P)
49800		B=ABS(HH(K))
49900		IF(ZERO(B,A).EQ.0)GO TO 1611
50000		IF(A.GT.B)GO TO 1711
50100		J=J+1
50200		GO TO 1911
50300	1711	P=HH(K)
50400		GO TO 2211
50500	1611	J=J+1
50600	2211	K=K+1
50700	1911	L=L+1
50800		HHH(L)=P
50900		GO TO 1511
51000	2011	CALL RLOOP(HH,H,JJ)
51100		KL=JJ
51200		GO TO 2111
51300	1811	CALL RLOOP(HH,HHH,L)
51400		KL=L
51500	2111	IF(ST.GE.KPG)GO TO 1333
51600		CALL RLOOP(E,G,M)
51700		KE=M
51800	C GO WAY BACK AND READ ANOTHER LINE.
51900		GO TO 1233
52000	1333	E(1)=0
52100		GO TO 2333
52200		TYPE 410,(HH(K),K=1,KL)
52300		WRITE(21,410)(HH(K),K=1,KL)
52400	2333	JD=1
52500	C JD IS COUNTER FOR DUMMY POSITIONS.
52600		DUMMY(1)=1
52700		ST=0
52800	183	B=0
52900		LL=2
53000	
53100		DO 181 K=1,N
53200		IF(NORH(L,K))GO TO 181
53300	C LOOK FOR DUMMY RHYTHMS.
53400		IF(L.LE.2)GO TO 2184
53500		RZ=O1
53600	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
53700		GO TO 1184
53800	2184	LF=MM(K)
53900		IF(Q(LF-1).NE.ST)GO TO 181
54000	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
54100		J=6
54200		IF(L.EQ.2)J=4
54300		RZ=Q(LF+J)
54400	1184	B=B+RZ
54500	184	V=ABS(HH(LL))
54600		IF(ZERO(B,V).GT.0)GO TO 182
54700	C FOUND RHYTH MATCH
54800		JD=JD+1
54900		DUMMY(JD)=LL
55000		LL=LL+1
55100		GO TO 181
55200	182	IF(B.LT.V-O1)GO TO 181
55300		LL=LL+1
55400		GO TO 184
55500	181	CONTINUE
55600		ST=ST+1
55700		IF(ST.LT.KPG)GO TO 183
55800	
55900	C NEXT SORT DUMMY ARRAY
56000		J=0
56100	185	DO 186 K=2,JD
56200		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
56300		DO 188 LL=K,JD
56400	188	DUMMY(LL-1)=DUMMY(LL)
56500		JD=JD-1
56600		GO TO 185
56700	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
56800		CALL EXCH(DUMMY(K),DUMMY(K-1))
56900		GO TO 185
57000	186	CONTINUE
57100	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
57200		PX=0
57300		LF=0
57400		K=1
57500		V=0
57600	
57700	81	K=K+1
57800		IF(K.GT.KL)GO TO 1433
57900		B=HH(K)
58000		A=B-V
58100		V=B
58200		IF(V)GO TO 82
58300	85	W=V
58400		IF(A.GT.O11)GO TO 89
58410	C	IF(A.GT.O1)GO TO 89
58500	C   WAS 0.011  ***** NOW IS AGAIN 12/81
58600	C  .GT. BECAUSE OF ROUND-OFF ERROR   (WAS 0.01 ABOVE AND BELOW 10/79)
58700		T=5
58800		IF(HH(K+1)-V.LE.O11)T=2
58810	C	IF(HH(K+1)-V.LE.O1)T=2
58900	C   WAS 0.011
59000		PX=PX+T
59100	C THIS FOR BARS, KSIG, METER
59200		GO TO 189
59300	89	PX=PX+14.0*EXP(ALOG(A)*0.5849624)
59400	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
59500	CC89	PX=PX+PFIBX(A)
59600	189	E(K)=PX
59700		IF(LF.NE.0)GO TO 86
59800		GO TO 81
59900	82	LF=K
60000	83	K=K+1
60100		V=HH(K)
60200		IF(V)GO TO 83
60300		A=V-W
60400		GO TO 85
60500	86	LL=LF-1
60600		D=E(K)-E(LL)
60700	87	S=-HH(LF)-HH(LL)
60800		T=HH(K)-HH(LL)
60900		T=S/T
61000	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
61100		E(LF)=E(LL)+D*T
61200		LF=LF+1
61300		IF(LF.NE.K)GO TO 87
61400		LF=0
61500		GO TO 81
61600	
61700	1433	GO TO 2433
61800		TYPE 410,(E(K),K=1,KL)
61900		WRITE(21,410)(E(K),K=1,KL)
62000	C  5 IS SPACE AFTER 1ST BARLINE
62100	2433	IF(Q(2).EQ.18)RNEXT=RNEXT-3.6
62200	C PUSH CLOSER TO PREVIOUS BARLINE IF 1ST ITEM IS METER 
62300		R8=RNEXT
62400	C POS OF 1ST BAR = END OF PREV. LINE
62500	     	IF(ENDLN.EQ.0)RNEXT=9
62600	C  MAKES ROOM FOR 1ST CLEF.
62700		KL=KL-1
62800		J=0
62900		R5=0
63000		KK=1
63100		JD=1
63200		W=0
63300		LF=0
63400	
63500		DO 80 K=1,N
63600		IF(NORH(L,K))GO TO 80
63700		A=Q(MM(K))
63800		IF(ZERO(A,W).EQ.0)GO TO 80
63900	C  SKIP IF SAME POS OF NOTE OR REST.
64000		W=A
64100		R7=R8
64200	190	J=J+1
64300		IF(J.LE.KL)GO TO 290
64400	203	FORMAT(' FOUND CENTERED WHOLE REST!')
64500	2203	LL=0
64600		IF(JCEN.GE.0)GO TO 220
64700		TYPE 203
64800		GO TO 121
64900	220	JJJ=-1
65000		L=0
65100	120	W=LL
65200		A=0
65300		DO 124 KB=1,N
65400		LF=NN(KB)
65500		IF(LF.GT.2)GO TO 124
65600		IF(LF.LE.0)GO TO 124
65700		KE=MM(KB)
65800		IF(Q(KE-1).NE.W)GO TO 124
65900	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
66000		JD=6
66100		IF(LF.EQ.2)JD=4
66200		A=A+Q(KE+JD)
66300	124	CONTINUE
66400		TYPE 123,LL,A
66500		LL=LL+1
66600		IF(L.EQ.0)L=A*100.+.5
66700	C  SAVE NUM. OF BEATS FIRST TIME.
66800		IF(L.NE.A*100.+.5)JJJ=0
66900	C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
67000		IF(LL.LT.KPG)GO TO 120
67100		IF(JJJ.NE.0)GO TO 121
67200		JJJ=0
67300		DO 320 KB=2,JJ
67400		A=HH(KB)-HH(KB-1)
67500		IF(A.LE.O1)GO TO 320
67600	C  SKIP BAR LINE VALUES (.01)
67700		JJJ=JJJ+1
67800		HH(JJJ)=4./A
67900	C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
68000	320	CONTINUE
68100		TYPE 420,(HH(KB),KB=1,JJJ)
68200		TYPE 421
68300	421	FORMAT(' **** COMPOSITE RHYTHM ERROR '/
68400		1 '      **** OR RHYTHM CROSSES BAR '/
68500		1 '           **** OR MISALIGNED NOTES')
68600		PAUSE
68700		GO TO 90
68800	420	FORMAT(10F8.2)
68900	123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
69000	121	PAUSE' *****RHYTHM MISMATCH*****'
69100		GO TO 90
69200	290	IF(DUMMY(JD).NE.J)GO TO 190
69300		JD=JD+1
69400	90 	R8=RNEXT+E(J)
69500		R4=R5
69600		R5=A
69700		X=(R8-R7)/(R5-R4)
69800		S=R7-R4*X
69900		DO 91 L=KK,K
70000		LL=MM(L)
70100	91	Q(LL)=S+X*Q(LL)
70200		KK=K+1
70300	80	CONTINUE
70400	
70500	CCC	IF(KK.GT.K)GO TO 180
70600		IF(KK.GT.N)GO TO 180
70700	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
70800		R7=Q(LL)-R5
70900	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
71000	CCC	DO 280 L=KK,K
71100		DO 280 L=KK,N
71200		LL=MM(L)
71300	280	Q(LL)=R7+Q(LL)
71400	180	JJ=JJ2-2
71500		L=JJ2
71600		M=0
71700	C FLAG FOR REST AT START OF LINE
71800	
71900		JJJ=-1
72000	C FLAG FOR 1ST BAR OF LINE 12/77
72100		V=0
72200		ACCI=0
72300		DO 12 J=1,JJ
72400		   R=CODEN(KPN,J,Q,LA)
72500	CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
72600		   IF(R.EQ.4)GO TO 680
72700		   IF(M)GO TO 780
72800		   IF(R.NE.2)GO TO 780
72900	C NEXT FOR RESTS
73000		   ACCI=ACCI+.5
73100	C  ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
73200	C SHOULD WE ALSO CONSIDER CLEFS??  MAYBE ADD LATER.
73300		   IF(KBR.EQ.0)GO TO 12
73400	C  LOOK FOR RESTS AT FRONT OF LINE.
73500		   X=0
73600		   CALL TURN(J,JJ,1,X)
73700		   PGTRN(KBR)=PGTRN(KBR)+X
73800		   M=-1
73900		   
74000	780	   IF(R.NE.1)GO TO 12
74100		   IF(V.NE.Q(LA+3))GO TO 782
74200	           IF(JACC)GO TO 781
74300	782	   ACCI=ACCI+.5
74400	   	   IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
74500		   JACC=-1
74600		   V=1
74700	C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
74800		   IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
74900	CCCC	V=RSTFAC(IFIX(Q(LA+2))+1)
75000	CC	ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
75100	CCCC	ACCI=ACCI+ACCISZ*V
75200	  	   ACCI=ACCI+V
75300	C  ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
75400		   V=Q(LA+3)
75500	781	   M=-1
75600		   IF(NOGRCE)GO TO 12
75700	C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
75800	C FOUND A NOTE
75900	C*************************	   IF(Q(LA+9).GT.0.05)GO TO 12 
76000		IF(Q(LA+9).NE.4.0/88.0)GO TO 12
76100	C JUMP IF NOT A GRACE NOTE
76200		   R=Q(LA+2)
76300	C  THE STAFF NUM.
76400		   DO 580 LF=J+1,JJ
76500		   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
76600			IF(Q(JD+2).NE.R)GO TO 580
76700		   	IF(Q(JD).LT.7)GO TO 580
76800		   	IF(Q(JD+9).EQ.0)GO TO 580
76900	C   CHORD NOTE
77000	  	   	R4=Q(LA+3) 
77100	CC	   	R4=Q(LA+3)-1 
77200		   	R5=Q(JD+3)
77300	C  THE STAFF # IS IN R2
77400		   	R8=RSTFAC(IFIX(R2+1))+.5
77500		   	IF(Q(JD+4).LT.80)R8=R8*2  
77600	C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
77700		   	R8=R5-R8
77800	CC	   	R8=R5-R8-1
77900	CCC	   	IF(R4.EQ.R5)GO TO 12
78000		   	IF(R4.NE.R5)GO TO 480
78100	C  GRACE NOTE AT START OF LINE ***** FIX THIS????
78200			DO 880 KE=1,LF-1
78300	880		Q(KPN(KE)+3)=R8
78400	C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
78500		   	GO TO 12
78600	480	   	R2=Q(LA+2)
78700		   	R9=R5
78800		   	CALL PTMOVE(Q,KPN)
78900	CC	   	TYPE 9999,Q(J+3),Q(JD+3)
79000	CC9999	   	FORMAT(2F)
79100		   	GO TO 12 
79200	580	   CONTINUE
79300		   GO TO 12
79400	C  ABOVE FOR GRACE NOTE SPACING.
79500	680	   KBR=KBR+1
79600	C BAR LINE COUNTER
79700		   T=Q(LA+3)
79800	C TOTAL SPACE
79900		   X=0
80000		   CALL TURN(J-1,1,-1,X)
80100		   CALL TURN(J+1,JJ,1,X)
80200	222	   PGTRN(KBR)=X
80300	C FINDS PAGE-TURN POSSIBILITIES
80400	C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
80500		   BFAC=.8
80600	CCC	   BFAC=.756
80700		   IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
80800	CC	   IF(KPG.LE.1)GO TO 3112
80900	C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
81000	CC	   R=RSTFAC(1)
81100	CC	   DO 5112 K=2,KPG
81200	CC5112	   IF(R.NE.RSTFAC(K))GO TO 6112
81300	CC	   GO TO 3112
81400	C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
81500	C  FIND LINE WITH MOST ACTIVITY.
81600	C  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
81700	CC6112	   DO 1112 K=1,8
81800	CC1112	   RN(K)=0
81900	CC	   DO 112 K=JK,J-1
82000	CC	   R=CODEN(KPN,K,Q,JD)
82100	CC	   IF(R.GT.3.)GO TO 112
82200	CC	   A=1.0
82300	C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
82400	CC	   IF(R.EQ.2)A=0.6
82500	C SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
82600	CC	   IF(R.NE.1)GO TO 4112
82700	CC	   IF(Q(JD).LT.7)GO TO 112
82800	CC	   IF(Q(JD+9).LE.0)GO TO 112
82900	CC4112	   LF=Q(JD+2)+1
83000	CC	   RN(LF)=RN(LF)+A 
83100	CC112	   CONTINUE
83200	CC	   JD=1
83300	CC	   B=RN(1)*RSTFAC(1)
83400	CC	   DO 2112 K=2,8
83500	CC	   A=RN(K)*RSTFAC(K)
83600	CC  	   IF(A.LE.B)GO TO 2112
83700	CC	   JD=K
83800	CC	   B=A
83900	CC2112	   CONTINUE
84000	CC	   BFAC=BFAC*(RSTFAC(JD)+.1)
84100	C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
84200	CXX	   BFAC=.84*RSTFAC(JD)
84300	3112	   IF(JJJ)RNEXT=RNEXT-6
84400	C JJJ=-1 IF 1ST BAR OF LINE. 12/77
84500		   JJJ=0
84600		   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
84700	C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
84800		   ACCI=0
84900	C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
85000		   K=J
85100		   JK=J+1
85200	C SET UP POINTER FOR NEXT BAR'S ITEMS.
85300		   RNEXT=T
85400	12	CONTINUE
85500	
85600		IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
85700		RNEXT=RNEXT+5
85800	CCC 11/9/78	RNEXT=RNEXT+3
85900		JJ2=L 
86000	C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
86100	CC???380	LCNT=0
86200	CC???	NDPY=0
86300	
86400	C JJ2 IS END OF PNTR DATA
86500	11	IF(IPG.EQ.2)NMPG=NAMX
86600	C IPG=2=REORDER INPUT FILE ONLY.
86700	C WHY DID I WRITE 2 EXTRA WORDS AT END OF Q ARRAY. (MAYBE NEEDED∞
86800	C  BUT IF 1ST EXTRA WAS NEG. (OR ZER0?) CAUSED BUG IN NEW 'INUMS' ROUTINE.
86900		JPQ=KPN(JJ2-1)+1
87000		Q(JPQ-1)=0
87100		CALL PUTEXT(NMPG,'PAG')
87200		CALL EXTOUT(RSTFAC,128)
87300	C*** 	CALL EXTOUT(PN,JJ2)
87400	C NEW SAVE FORMAT DOESN'T NEED ABOVE 3/80
87500		CALL EXTOUT(Q,JPQ)
87600		IF(IPG.EQ.2)CALL EXIT
87700		CALL FINEXT
87800	
87900		LASTNM=NMPG
88000		NMPG=NMPG+2
88100		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
88200	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
88300		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
88400		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
88500	122	ENDLN=RNEXT
88600		END